home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 5 / Apprentice-Release5.iso / Source Code / C / Applications / Moscow ML 1.31 / source code / mosml / src / runtime / hash.c < prev    next >
Encoding:
C/C++ Source or Header  |  1996-07-03  |  2.6 KB  |  110 lines  |  [TEXT/R*ch]
  1. /* The generic hashing primitive */
  2.  
  3. #include "mlvalues.h"
  4. #include "memory.h"
  5. #include "str.h"
  6.  
  7. static unsigned long hash_accu;
  8. static long hash_univ_limit, hash_univ_count;
  9.  
  10. static void hash_aux();
  11.  
  12. value hash_univ_param(count, limit, obj) /* ML */
  13.      value obj, count, limit;
  14. {
  15.   hash_univ_limit = Long_val(limit);
  16.   hash_univ_count = Long_val(count);
  17.   hash_accu = 0;
  18.   hash_aux(obj);
  19.   return Val_long(hash_accu & 0x3FFFFFFF);
  20.   /* The & has two purposes: ensure that the return value is positive
  21.      and give the same result on 32 bit and 64 bit architectures. */
  22. }
  23.  
  24. #define Alpha 65599
  25. #define Beta 19
  26. #define Combine(new)  (hash_accu = hash_accu * Alpha + (new))
  27. #define Combine_small(new) (hash_accu = hash_accu * Beta + (new))
  28.  
  29. static void hash_aux(obj)
  30.      value obj;
  31. {
  32.   unsigned char * p;
  33.   mlsize_t i;
  34.   tag_t tag;
  35.  
  36.   hash_univ_limit--;
  37.   if (hash_univ_count < 0 || hash_univ_limit < 0) return;
  38.  
  39.   if (Is_long(obj)) {
  40.     hash_univ_count--;
  41.     Combine(Long_val(obj));
  42.     return;
  43.   }
  44.  
  45.   /* Atoms are not in the heap, but it's better to hash their tag
  46.      than to do nothing. */
  47.  
  48.   if (Is_atom(obj)) {
  49.     tag = Tag_val(obj);
  50.     hash_univ_count--;
  51.     Combine_small(tag);
  52.     return;
  53.   }
  54.  
  55.   /* Pointers into the heap are well-structured blocks.
  56.      We can inspect the block contents. */
  57.   
  58.   if (Is_in_heap(obj) || Is_young(obj)) {
  59.     tag = Tag_val(obj);
  60.     switch (tag) {
  61.     case String_tag:
  62.       hash_univ_count--;
  63.       i = string_length(obj);
  64.       for (p = &Byte_u(obj, 0); i > 0; i--, p++)
  65.         Combine_small(*p);
  66.       break;
  67.     case Double_tag:
  68.       /* For doubles, we inspect their binary representation, LSB first.
  69.          The results are consistent among all platforms with IEEE floats. */
  70.       hash_univ_count--;
  71. #ifdef BIG_ENDIAN
  72.       for (p = &Byte_u(obj, sizeof(double) - 1), i = sizeof(double);
  73.            i > 0;
  74.            p--, i--)
  75. #else
  76.       for (p = &Byte_u(obj, 0), i = sizeof(double);
  77.            i > 0;
  78.            p++, i--)
  79. #endif
  80.         Combine_small(*p);
  81.       break;
  82.     case Abstract_tag:
  83.     case Final_tag:
  84.       /* We don't know anything about the contents of the block.
  85.          Better do nothing. */
  86.       break;
  87.     case Reference_tag:
  88.       hash_univ_count--;
  89.       Combine_small(tag);
  90.       i = Wosize_val(obj);
  91.       Combine_small(i);
  92.       break;
  93.     default:
  94.       hash_univ_count--;
  95.       Combine_small(tag);
  96.       i = Wosize_val(obj);
  97.       while (i != 0) {
  98.         i--;
  99.         hash_aux(Field(obj, i));
  100.       }
  101.       break;
  102.     }
  103.     return;
  104.   }
  105.  
  106.   /* Otherwise, obj is a pointer outside the heap, to an object with
  107.      a priori unknown structure. Use its physical address as hash key. */
  108.   Combine((long) obj);
  109. }
  110.